home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tp256d.exe / SVGADEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-28  |  5.9 KB  |  194 lines
  1. { Super VGA  Demo Program           }
  2. {   Thomas Design                   }
  3. {   August 11, 1989                 }
  4.  
  5. uses
  6.   Graph,crt,
  7.   VGAEXTRA,                            { dacpalette(..) and flashmodes }
  8.   ISVGADET;
  9. var
  10.   Gd, Gm : integer;
  11.   DAC    : RGB;                        { DAC is a byte aligned array of char }
  12.  
  13. {------------- Hue Saturation & Intensity  TO  rgb -----------------}
  14. procedure hsi2rgb(h,s,i: real; var Rvalue,Gvalue,Bvalue : integer);
  15.   var
  16.       t: real;
  17.       rv,gv,bv: real;
  18.   begin { procedure hsi2rgb }
  19.     t:=2*pi*h;
  20.     rv:=1+s*sin(t-2*pi/3);
  21.     gv:=1+s*sin(t);
  22.     bv:=1+s*sin(t+2*pi/3);
  23.     t:=63.999*i/2;
  24.     Rvalue:=trunc(rv*t);
  25.     Gvalue:=trunc(gv*t);
  26.     Bvalue:=trunc(bv*t);
  27. end;
  28.  
  29. {------------- Load the inital color palette -----------------------}
  30. procedure LoadPalette(HueStep: real;SatStep : real;IntenStep : real);
  31. var index : integer;
  32.     h,s,i : real;
  33.     h1,s1,i1 : real;
  34.     r,g,b : integer;
  35. begin
  36.     h1 := 1.0 / HueStep;
  37.     h  := 0;                           { start with hue value of zero }
  38.     s  := 1.00;
  39.     i  := 1.00;
  40.     for index := 1 to 256 do begin
  41.       hsi2rgb(h,s,i,R,G,B);            { compute RGB values using HSI }
  42.       DAC[index][0] := R;              { load each RGB value into the array }
  43.       DAC[index][1] := G;
  44.       DAC[index][2] := B;
  45.       h := h + h1;
  46.       i := i - IntenStep;
  47.       s := s - SatStep;
  48.     end;
  49.     Dac[0][0] := 0;                    { Insure the background stays black }
  50.     Dac[0][1] := 0;
  51.     Dac[0][2] := 0;
  52.     dacpalette(DAC);
  53. end;
  54.  
  55. {------------ Initialize the graphics system -----------------------}
  56. procedure InitGraphics;                { setup the SuperVGA driver }
  57.   var count : integer;
  58.       Error : integer;
  59. begin
  60.   gd := InstallUserDriver('ISVGA256',@_DetectISVGA256);  { must say   gd := Install...  to work }
  61.   gd := DETECT;
  62.   InitGraph(gd, gm ,'');               { use the default graphics mode }
  63.   Error := GraphResult;
  64.   if Error <> grOK then                { if SVGA driver not available, error! }
  65.   begin
  66.      Writeln('Graphics error: ', GraphErrorMsg(Error));
  67.      Halt(1);
  68.   end;
  69.   LoadPalette(32,0,0);
  70. end;
  71.  
  72. {------------ use circles in graphics demo -------------------------}
  73. procedure CirclePlay;
  74.   var
  75.      FillColor                  : integer;
  76.      MaxX, MaxY                 : integer;
  77.      MaxRadius                  : integer;
  78.      Xcenter,Ycenter            : integer;
  79.      Ballx,Bally                : integer;
  80.      Index                      : byte;
  81.      xincrement,yincrement      : integer;
  82.      Testx,Testy                : integer;
  83.      MirrorX,MirrorY            : integer;
  84.      test                       : char;
  85. begin
  86.   Maxradius  := getmaxx div 35;
  87.   MaxX       := getmaxx;
  88.   MaxY       := getmaxy;
  89.   Xcenter    := MaxX div 2;
  90.   Ycenter    := MaxY div 2;
  91.   Ballx      := Xcenter;
  92.   Bally      := Ycenter;
  93.   xincrement := -Maxradius;
  94.   yincrement := -Maxradius;
  95.   randomize;
  96.   Index  := 1;
  97.   repeat
  98.       SetColor(Index);
  99.       SetFillStyle(SOLIDFILL, Index);
  100.       FillEllipse(Ballx, Bally,Maxradius, Maxradius);
  101.       Testx := Ballx - Xcenter;
  102.       Testy := Bally - Ycenter;
  103.       MirrorX := -Testx + Xcenter;
  104.       FillEllipse(MirrorX,Bally,Maxradius, Maxradius);
  105.       MirrorY := -Testy + Ycenter;
  106.       FillEllipse(Ballx,MirrorY,Maxradius, Maxradius);
  107.       FillEllipse(MirrorX,MirrorY,Maxradius, Maxradius);
  108.       Ballx := Ballx + xincrement;
  109.       Bally := Bally + yincrement;
  110.       inc(Maxradius);
  111.       If ((Ballx <= 0) or (Ballx >= MaxX)) then begin
  112.          xincrement := xincrement * -1;
  113.          Maxradius := abs(xincrement);
  114.       end;
  115.       If ((Bally <= 0) or (Bally >= MaxY)) then begin
  116.          yincrement := yincrement * -1;
  117.          Maxradius := abs(xincrement);
  118.       end;
  119.       inc(index);
  120.       if (Index = 0) then begin
  121.           inc(Index);
  122.           LoadPalette(32,random/256,random/256);
  123.           Maxradius := getmaxx div (random(20) + 20);
  124.       end;
  125.   until KeyPressed;
  126.   cleardevice;
  127.   test := readkey;
  128. end;
  129.  
  130. {------------ use bars in graphics demo -------------------------}
  131. procedure BarPlay;
  132.   var
  133.      FillColor                  : integer;
  134.      MaxX, MaxY                 : integer;
  135.      Maxwidth                   : integer;
  136.      Xcenter,Ycenter            : integer;
  137.      LocX,LocY                  : integer;
  138.      Index                      : byte;
  139.      xincrement,yincrement      : integer;
  140.      Testx,Testy                : integer;
  141.      MirrorX,MirrorY            : integer;
  142.      test                       : char;
  143. begin
  144.   Maxwidth   := getmaxx div 100;
  145.   MaxX       := getmaxx;
  146.   MaxY       := getmaxy;
  147.   Xcenter    := MaxX div 2;
  148.   Ycenter    := MaxY div 2;
  149.   LocX      := Xcenter;
  150.   LocY      := Ycenter;
  151.   xincrement := -Maxwidth;
  152.   yincrement := -Maxwidth;
  153.   randomize;
  154.   Index  := 1;
  155.   repeat
  156.       SetColor(Index);
  157.       SetFillStyle(SOLIDFILL, Index);
  158.       bar(LocX, LocY,LocX+Maxwidth, LocY+Maxwidth);
  159.       Testx := LocX - Xcenter;
  160.       Testy := LocY - Ycenter;
  161.       MirrorX := -Testx + Xcenter;
  162.       bar(MirrorX,LocY,MirrorX+Maxwidth, LocY+Maxwidth);
  163.       MirrorY := -Testy + Ycenter;
  164.       bar(LocX,MirrorY,LocX+Maxwidth, MirrorY+Maxwidth);
  165.       bar(MirrorX,MirrorY,MirrorX+Maxwidth, MirrorY+Maxwidth);
  166.       LocX := LocX + xincrement;
  167.       LocY := LocY + yincrement;
  168.       inc(Maxwidth);
  169.       If ((LocX <= 0) or (LocX >= MaxX)) then begin
  170.          xincrement := xincrement * -1;
  171.          Maxwidth := abs(xincrement);
  172.       end;
  173.       If ((LocY <= 0) or (LocY >= MaxY)) then begin
  174.          yincrement := yincrement * -1;
  175.          Maxwidth := abs(xincrement);
  176.       end;
  177.       inc(index);
  178.       if (Index = 0) then begin
  179.           inc(Index);
  180.           LoadPalette(32,random/256,random/256);
  181.       end;
  182.   until KeyPressed;
  183.   cleardevice;
  184.   test := readkey;
  185. end;
  186.  
  187. begin
  188.     InitGraphics;
  189.     CirclePlay;
  190.     BarPlay;
  191.     restorecrtmode;
  192. end.
  193.  
  194.